home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 7 / Amiga Format AFCD07 (Dec 1996, Issue 91).iso / serious / shareware / comms / internet / web-related / apache_1.0.5 / cgi-bin / counter < prev    next >
Text File  |  1996-06-25  |  20KB  |  806 lines
  1. #! /bin/perl
  2.  
  3. # cgi-bin access counter program
  4. # Version 4.0.2
  5. #
  6. # Copyright (C) 1995 George Burgyan
  7. #
  8. # This program is free software; you can redistribute it and/or modify
  9. # it under the terms of the GNU General Public License as published by
  10. # the Free Software Foundation; either version 2 of the License, or (at
  11. # your option) any later version.
  12. #
  13. # This program is distributed in the hope that it will be useful, but
  14. # WITHOUT ANY WARRANTY; without even the implied warranty of
  15. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
  16. # General Public License for more details.
  17. #
  18. # A full copy of the GNU General Public License can be retrieved from
  19. # http://www.webtools.org/counter/copying.html
  20. #
  21. # gburgyan@webtools.org
  22. #
  23. # George Burgyan
  24. # 1380 Dill Road
  25. # South Euclid, OH 44121
  26. #
  27. # For more information look at http://www.webtools.org/counter/
  28.  
  29. # QUICK WAY TO GET THE COUNTER TO WORK
  30. #-------------------------------------
  31. # 1> Create a file called access_count in the cgi-bin directory
  32. #    touch access_count or echo >access_count will do this for you
  33. #
  34. # 2> Make sure its writeable by others, readable by all by doing
  35. #      chmod a+r access_count
  36. #      chmod o+w access_count
  37. #
  38. # 3> Create a .htaccess file in all the directories where the counter
  39. #    will be used. Put the following in the .htaccess file:
  40. #
  41. #     Options Indexes FollowSymLinks Includes
  42. #     AddType application/x-httpd-cgi .cgi
  43. #     AddType text-x-server-parsed-html .html
  44. #
  45. # 4> In the html files that will use the counter put the following line:
  46. #
  47. #     <!--#exec cgi="/cgi=bin/counter"-->
  48. #
  49. # 5> TADA!!
  50. ########################################################################
  51. #
  52. #   CHANGE THESE TO SUIT YOUR SITE
  53. #
  54.  
  55. # The default language option (english, french, swedish)
  56. $default_lang = "english";
  57.  
  58. # The name of the file to use.    You should probably give this an absolute path
  59. $FileName = "access_count";
  60.  
  61. # Replace with a list of regular expression IP addresses that we
  62. # are supposed to ignore.  If you don't know what this means, just use
  63. # "\." instead of periods.  Comment out entirely to ignore nothing.
  64.  
  65. #@IgnoreIP = ("199\.18\.203\..*",
  66. #          "199\.18\.159\.1",
  67. #          );
  68.  
  69. # Aliases: Set this up so that diffent pages will all yield the same
  70. # count.  For instance, if you have a link like "index.html -> home.html"
  71. # set it up like ("/index.html", "/home.html").  Make sure you give a full
  72. # path to it. This will treat "/index.html" as if it were "/home.html".
  73.  
  74. %Aliases = ("/fakename.html", "/realname.html",
  75.         "/index.html", "/home.html",
  76.         );
  77.  
  78.  
  79. # AUTOMATICALLY SET BY INSTALL!!   Modify only if necessary!!!
  80. #
  81. # BaseName: set to whatever you have counter installed as.  This is
  82. # used to derive the arguments.  No not touch the next comment.
  83.  
  84. ### AUTOMAGIC ###
  85. $BaseName = "counter";
  86.  
  87. # counter  or  counterbanner  or  counterfiglet
  88. #
  89. # Outputs the number of times a specific page has been accessed.
  90. # The output depends on which page 'called' it, and what the program
  91. # is named:
  92. #
  93. # The counter can "take arguments" via its name.  That is, if you tack
  94. # -arg to the end of the program name, -arg is taken to be an argument.
  95. # For example, if you call the counter 'counter-ord', '-ord' is considered
  96. # an argument, and an ordinal count (1st, 2nd, 3rd, ...) will be printed
  97. # instead of (1, 2, 3, ...).  Note that counterord does the same thing as
  98. # counter-ord for backward compatibility.
  99. #
  100. # Currently recognized arguments:
  101. #
  102. #  -f=font    sets "font" to be the font for figlet
  103. #  -lang=lang    sets the language used to ordinalize to "lang"
  104. #  -nc        no count; don't to write the incremented count back to the file
  105. #  -nl        no link; don't automatically generate a link
  106. #  -nd        no display; don't display anything, just count
  107. #  -ord     make an ordinal count instead of regular
  108. #  -doc=document override the DOCUMENT_URI environment variable
  109. #
  110. # Example:  counterfiglet-ord-f=bigfont-nc
  111. #
  112. # This will cause the counter to call figlet as the output routine, printing
  113. # in a big font an ordinal count, without updating the access count file.
  114. # Note that the order of arguments is irrelevant so long as you spell the
  115. # file name correctly.    It is generally assumed that the ability to take
  116. # different arguments/use different output routines is done with symlinks:
  117. # i.e. ln -s counter counterfiglet-ord-f=bigfont-nc
  118. #
  119. # More complete documentation can be found at
  120. # http://www.webtools.org/counter/
  121. #
  122. ########################################################################
  123. #
  124. # Thing that shouldn't really need changing, but are configurable anyway.
  125. #
  126.  
  127. # Maximum number of times to try to lock the file.
  128. # Each try is .1 second.  Try for 1 second.
  129. $MaxTries = 10;
  130.  
  131. # Set this to point to something, or comment it out, and it
  132. # won't be a link at all.
  133. $Link = "http://www.webtools.org/counter/";
  134.  
  135. # Whether or not to use locking.  If perl complains that flock is not
  136. # defined, change this to 0.  Not *really* necessary because we check
  137. # to make sure it works properly.
  138. $UseLocking = 1;
  139.  
  140. # What version of the counter file format are we using?
  141. $FileVersion = "02.000";
  142.  
  143. # Common names of the counter to install...
  144. @CommonExtensions = ("-ord",      # Ordinam
  145.              "figlet",    # Figlet'ed
  146.              "figlet-ord",# Ordinal figlet
  147.              "banner",    # Bannered
  148.              "banner-ord",# Ordinal banner
  149.              );
  150. #
  151. #########################################################################
  152. #
  153. # Misc documents to refer people to in case of errors.
  154. #
  155. $CreateFile = "<a href=\"http://www.webtools.org/counter/faq.html#create\">[Error Creating Counter File -- Click for more info]</a>";
  156. $AccessRights = "<a href=\"http://www.webtools.org/counter/faq.html#rights\">[Error Opening Counter File -- Click for more info]</a>";
  157. $TimeoutLock = "[Timeout locking counter file]";
  158. $BadVersion = "<a href=\"http://www.webtools.org/counter/\">[Version access_count newer than this program.  Please upgrade.]</a>";
  159.  
  160. #########################################################################
  161. #
  162. # The actual program!
  163.  
  164. ### Stage 1
  165. ###
  166. ### Parse the arguments...  (just ignore this part)
  167.  
  168. # Get arguments from program name.  Argh...what a horrible way to do it!
  169. $prog = $0;
  170. $prog =~ s/(\.cgi|\.pl)//;      #strip .cgi|.pl name extension
  171. $prog =~ s!^(.*/)!!;            # separate program name
  172. $prog =~ s/\\(.)/sprintf("%%%02x", ord($1))/ge; # quote \c to %xx
  173.  
  174. ($printer, @args) = split(/-/, $prog);  # args are separated by dashes
  175. $printer =~ s/%(..)/pack("c", hex($1))/ge; # unquote printer function name
  176. $printer =~ s/$BaseName/counter/; # Make it cannonical.
  177.  
  178. # This gets path info, which is only applicable if you are using our
  179. # ssis script (see above).  This makes counter/ord the same as counter-ord
  180. push(@args, split("/", $ENV{"PATH_INFO"})) if $ENV{"PATH_INFO"};
  181.  
  182. # put them in assoc array %arg
  183. foreach (@args) # means do this for each element in the array
  184. {
  185.     s/%(..)/pack("c", hex($1))/ge;      # unquote %xx
  186.     /^([^=]*)=?(.*)$/;                  # extract "=" part, if any
  187.     $arg{$1} = $2 ? $2 : 1;
  188. }
  189.  
  190. if ($ARGV[0] eq '-install') {
  191.     &CheckPerl;
  192.     &SetBaseName;
  193.     &MakeCommon(0);
  194.     exit(0);
  195. }
  196.  
  197. if ($ARGV[0] eq '-installforce') {
  198.     &CheckPerl;
  199.     &SetBaseName;
  200.     &MakeCommon(1);
  201.     exit(0);
  202. }
  203.  
  204. undef $Link if $arg{'nl'};      # make link?
  205.  
  206. ### Stage 2
  207. ###
  208. ### Print out the header
  209.  
  210. # Print out the header
  211. print "Content-type: text/html\n\n";
  212.  
  213.  
  214.  
  215. ### Stage 3
  216. ###
  217. ### Open the access_count file for read-write taking all the precautions
  218.  
  219. # Make sure the file exists:
  220. if (!(-f $FileName)) {
  221.     if (!open (COUNT,">$FileName")) {
  222.     # Can't create the file
  223.     print $CreateFile;
  224.     exit 1;
  225.     } else {
  226.     # We got the file, print out the version number
  227.     print COUNT "$FileVersion\n";
  228.     $version = 2;
  229.     }
  230. } else {
  231.     if (!((-r $FileName) && (-w $FileName))) {
  232.     # Make sure that we can in fact read and write to the file in
  233.     # question.  If not, direct them to the FAQ.
  234.     print $AccessRights;
  235.     exit 1;
  236.     }
  237.  
  238.     if (!open (COUNT,"+<$FileName")) {  # Now make sure it *really* opens
  239.     print $AccessRights;        # ...just in case...
  240.     exit 1;
  241.     }
  242.  
  243.     # Try to read in a version number
  244.     $version = <COUNT>;
  245.     if (!($version =~ /^\d+.\d+$/)) {
  246.     # No version number, assume version 1 and reset the file.
  247.     $version = 1;
  248.     seek(COUNT,0,0);
  249.     }
  250. }
  251.  
  252. # This is for the future: the access_count file will have a version number.
  253. if ($version > 2) {
  254.     print $BadVersion;
  255.     exit 1;
  256. }
  257.  
  258. ### Stage 4
  259. ###
  260. ### Attempt to lock the file
  261.  
  262.  
  263. $lockerror = &LockFile(COUNT);
  264.  
  265. # You would figure that $MaxTries would equal 0 if it didn't work.  The
  266. # post-decrement takes it to -1 when the loop finally exits.
  267. if ($lockerror) {
  268.     print $TimeoutLock;
  269.     exit(0);
  270. }
  271.  
  272.  
  273. ### Stage 5
  274. ###
  275. ### Check if we need to update the file to a newer version
  276.  
  277. if ($version < 2) {
  278.     &UpdateVersion1;
  279. }
  280.  
  281.  
  282. ### Stage 6
  283. ###
  284. ### Convert the information the server gave us into the document
  285. ### identifier.
  286.  
  287. # Make sure perl doesn't spit out warnings...
  288. if (defined $ENV{'DOCUMENT_URI'}) {
  289.     $doc_uri = $ENV{'DOCUMENT_URI'};
  290. } else {
  291.     $doc_uri = "";
  292. }
  293.  
  294. # Campatibility: Version 2 files have the server name in front if and
  295. # only if it doesn't have a "~" in it.
  296.  
  297. $old_uri = $doc_uri;
  298.  
  299. # Add the server name in front to support multi-homed hosts if and only if
  300. # it doesn't have a "~" in it.  (usernames are global in most multi-homed
  301. # settings
  302. if (defined $ENV{'SERVER_NAME'} && !$doc_uri =~ /~/) {
  303.     $doc_uri = $ENV{'SERVER_NAME'} . "/" . $doc_uri;
  304. }
  305.  
  306. if (defined $arg{'doc'}) {
  307.     $doc_uri = $arg{'doc'};
  308. }
  309.  
  310. $doc_uri = $Aliases{$doc_uri} if defined $Aliases{$doc_uri};
  311.  
  312.  
  313. ### Stage 7
  314. ###
  315. ### Find the relevant place in the file
  316.  
  317. $location = tell COUNT;
  318. while ($line = <COUNT>) {
  319.     # Read the file line-by-line.
  320.     if (($uri,$accesses) = ($line =~ /^'(\S*)' (\d\d\d\d\d\d\d\d\d\d)$/)) {
  321.     # An old line
  322.     if ($uri eq $old_uri) {
  323.         &ConvertDocV1($doc_uri,$old_uri,$accesses,$location);
  324.         last;
  325.     }
  326.     } elsif (($uri,$accesses,$flags) = ($line =~ /^'(\S*)' (\d\d\d\d\d\d\d\d\d\d) (\w\w\w\w)$/)) {
  327.     # A new line
  328.     if ($uri eq $doc_uri) {
  329.         $flags = hex($flags);
  330.         last;
  331.     }
  332.     }
  333.  
  334.     last if ($uri eq $doc_uri);
  335.     $location = tell COUNT;
  336.  
  337.     #reset the fields
  338.     $accesses = 0;
  339.     $flags = 0;
  340. }
  341.  
  342.  
  343. ### Stage 8
  344. ###
  345. ### Update the access count of the file
  346.  
  347. $accesses += 1; # *NOT* '++' because we don't want '++'s magic
  348.  
  349.  
  350. ### Stage 9
  351. ###
  352. ### Figure out what to print out
  353.  
  354. # If we have to ordinalize, do it now.
  355. if (defined $arg{'ord'}) {
  356.     if (defined $arg{'lang'}) {
  357.     $ord = eval("&ordinalize_$arg{lang}($accesses)");
  358.     } else {
  359.     $ord = &ordinalize($accesses);
  360.     }
  361. } else {
  362.     $ord = "";
  363. }
  364. $to_print = $accesses . $ord;
  365.  
  366. # Give it to the printer function to actually produce the output from the
  367. # ascii text that we have (to_print)
  368. ($count, $nLink) = eval("&output_$printer('$to_print')");
  369.  
  370. # If the above line gave us an error, default to just the text.
  371. if ($@) {
  372.     ($count, $nLink) = &output_counter($to_print);
  373. }
  374.  
  375. ### Stage 10
  376. ###
  377. ### Now we actually tell the browser what the count is.
  378.  
  379. if (! $arg{"nd"} ) {            # If we print anything
  380.     # Print out a link to something informative (if we were requested to)
  381.     print "<a href=\"$nLink\">" if $nLink;
  382.     print $count;
  383.     print "</a>" if $nLink;
  384. }
  385.  
  386.  
  387. ### Stage 11
  388. ###
  389. ### Check if we are supposed to update the count in the file.  (ie. we're
  390. ### not ignoring the host that just accessed us)
  391.  
  392. # Make sure we are not ignoring the host:
  393.  
  394. $ignore = 0;
  395. $ignore = grep($ENV{"REMOTE_ADDR"} =~ /$_/, @IgnoreIP) if defined ($ENV{"REMOTE_ADDR"});
  396. $ignore = $ignore || $arg{"nc"};
  397.  
  398. ### Stage 12
  399. ###
  400. ### Actually write the updated information back to the file
  401.  
  402. if (!$ignore)                   # If we aren't ignoring this access
  403. {
  404.     # Now update the counter file
  405.     seek(COUNT, $location, 0);
  406.     $longaccesses = sprintf("%010.10d", $accesses);
  407.     $hexflags = sprintf("%04.4x", $flags);
  408.     print COUNT "'$doc_uri' $longaccesses $hexflags\n";
  409. }
  410.  
  411. &UnlockFile(COUNT);
  412.  
  413. close COUNT;
  414.  
  415. #######################################################################
  416. #
  417. # Support functions
  418. #
  419.  
  420. # translate_output
  421. #
  422. # Quote any special characters with HTML quoting.
  423.  
  424. sub translate_output {
  425.     local($string) = @_;
  426.  
  427.     $_ = $string;
  428.  
  429.     s/è/è/g;
  430.  
  431.     return $_;
  432. }
  433.  
  434. sub LockFile {
  435.     local(*FILE) = @_;
  436.     local($TrysLeft) = $MaxTries;
  437.  
  438.     if ($UseLocking) {
  439.     # Try to get a lock on the file
  440.     while ($TrysLeft--) {
  441.  
  442.         # Try to use locking, if it doesn't use locking, the eval would
  443.         # die.  Catch that, and don't use locking.
  444.  
  445.         # Try to grab the lock with a non-blocking (4) exclusive (2) lock.
  446.         # (4 | 2 = 6)
  447.         $lockresult = eval("flock(COUNT,6)");
  448.  
  449.         if ($@) {
  450.         $UseLocking = 0;
  451.         last;
  452.         }
  453.  
  454.         if (!$lockresult) {
  455.         select(undef,undef,undef,0.1); # Wait for 1/10 sec.
  456.         } else {
  457.         last;        # We have gotten the lock.
  458.         }
  459.     }
  460.     }
  461.  
  462.     if ($TrysLeft >= 0) {
  463.     # Success!
  464.     return 0;
  465.     } else {
  466.     return -1;
  467.     }
  468. }
  469.  
  470. sub UnlockFile {
  471.     local(*FILE) = @_;
  472.  
  473.     if ($UseLocking) {
  474.     flock(FILE,8);                  # Unlock the file.
  475.     }
  476. }
  477.  
  478.  
  479. ####################################################################
  480. #
  481. # Installation helpers
  482. #
  483.  
  484.  
  485. # SetBaseName
  486. #
  487. # Change the counter program itself to set the basename
  488.  
  489. sub SetBaseName {
  490.     local($name) = $0;
  491.  
  492.     $name =~ s/^.*\/([^\/]+)$/$1/; # Strip off any of the path
  493.  
  494.     if ($name eq $BaseName) {   # The way we're set up now!!!
  495.     return;         # Don't need to change a thing.
  496.     }
  497.  
  498.     if (!open(COUNTERFILE, "+<$0")) {
  499.     print "Can't modify program.  Set \$BaseName manually.\n";
  500.     return;
  501.     }
  502.  
  503.     print "Configuring \$BaseName variable...\n";
  504.  
  505.     local($oldsep) = $/;
  506.     undef($/);
  507.  
  508.     local($program) = <COUNTERFILE>;
  509.  
  510.     # The next line does all the magic.
  511.     $program =~ s/\#\#\# AUTOMAGIC \#\#\#\n\$BaseName = \"[^\"]+\";\n/\#\#\# AUTOMAGIC \#\#\#\n\$BaseName = \"$name\";\n/;
  512.  
  513.     seek(COUNTERFILE,0,0) || return;
  514.     truncate(COUNTERFILE,0);
  515.     print COUNTERFILE $program;
  516.     close COUNTERFILE;
  517. }
  518.  
  519. # CheckPerl
  520. #
  521. # Make sure that the "#! /[path]/perl" points to something real...
  522.  
  523. sub CheckPerl {
  524.     if (!open(COUNTERFILE, "<$0")) {
  525.     print "Can't check to make sure Perl is in the right place.\n";
  526.     return;
  527.     }
  528.     print "Checking to make sure Perl is found properly...\n";
  529.  
  530.     $firstline = <COUNTERFILE>;
  531.     ($command) = ($firstline =~ /^\#! *([^\s]+) *$/);
  532.     close(COUNTERFILE);
  533.  
  534.     if (! -x $command) {
  535.     print "The location of Perl is misconfigured.  Please edit the\n";
  536.     print "first line of this program to point to the locally installed\n";
  537.     print "copy of perl.\n\n";
  538.     print "Currently, it is configured to be \"$command\", however,\n";
  539.     print "that file either does not exist or is not a program.\n\n";
  540.     print "Some common locations for Perl are:\n";
  541.     print "  /usr/bin/perl\n";
  542.     print "  /usr/local/bin/perl\n";
  543.     print "  /opt/gnu/bin/perl\n\n";
  544.     exit;
  545.     }
  546. }
  547.  
  548. # MakeCommon
  549. #
  550. # Make some common links to the counter
  551.  
  552. sub MakeCommon {
  553.     local($force) = @_;
  554.     local($ext);
  555.  
  556.     print "Installing the counter...\n";
  557.     print "   ...making counter executable\n";
  558.     chmod(0755,$0);
  559.  
  560.     local($path, $name, $cgi);
  561.     $name = $0;
  562.     if ($name =~ /^(.*\/)([^\/]+)$/) {
  563.     $path = $1; $name = $2;
  564.     }
  565.     if ($name =~ /^(.*)(\.cgi)$/) {
  566.     $name = $1, $cgi = $2;
  567.     }
  568.  
  569.     foreach $ext (@CommonExtensions) {
  570.     print  "   ...making link from $path$name$cgi to $path$name$ext$cgi\n";
  571.     if (!&MakeLink("$path$name$cgi","$path$name$ext$cgi",$force)) {
  572.         # An error occured while making the link.  :-(
  573.  
  574.         print "     *** An error occured while making the link.\n";
  575.     }
  576.     }
  577.     print "...done!\n";
  578. }
  579.  
  580. # MakeLink
  581. #
  582. # Actually create the link.
  583.  
  584. sub MakeLink {
  585.     local($oldname,$newname,$force) = @_;
  586.  
  587.     # Check to see if we can make symbolic links instead of hard links
  588.     if (!defined $symlink_exists) {
  589.     $symlink_exists = (eval 'symlink("","");', $@ eq '');
  590.     }
  591.  
  592.     if ($force) {
  593.     # Check to see if the file exists
  594.     if (-e $newname) {
  595.         if (!unlink ($newname)) {
  596.         return 0;
  597.         }
  598.     }
  599.     }
  600.  
  601.     if ($symlink_exists) {
  602.     return symlink($oldname, $newname);
  603.     } else {
  604.     return link($oldname,$newname);
  605.     }
  606. }
  607.  
  608. ####################################################################
  609. #
  610. # Ordinalizing functions
  611. #
  612.  
  613. # ordinalize
  614. #
  615. # Call the appropriate ordinalize function for the default language
  616.  
  617. sub ordinalize
  618. {
  619.     local($count) = @_;
  620.  
  621.     if (defined $arg{'lang'}) {
  622.     return eval("&ordinalize_$arg{lang}($count)");
  623.     } else {
  624.     return eval("&ordinalize_$default_lang($count)");
  625.     }
  626. }
  627.  
  628.  
  629. # ordinalize_english
  630. #
  631. # Figure out what suffix (st, nd, rd, th) a number would have in ordinal
  632. # form and return that extension.
  633.  
  634. sub ordinalize_english {
  635.     local($count) = @_;
  636.     local($last, $last2);
  637.  
  638.     $last2 = $count % 100;
  639.     $last = $count % 10;
  640.  
  641.     if ($last2 < 10 || $last2 > 13) {
  642.     return "st" if $last == 1;
  643.     return "nd" if $last == 2;
  644.     return "rd" if $last == 3;
  645.     }
  646.  
  647.     return "th";                # Catch "eleventh, twelveth, thirteenth" etc.
  648. }
  649.  
  650. # ordinalize_french
  651. #
  652. # Trivial...  Return the extension for french.    The only exception is 1.
  653. # Thank you Chris Polewczuk <chris@hexonx.com>
  654.  
  655. sub ordinalize_french {
  656.     local ($count) = @_;
  657.  
  658.     if ($count == 1) {
  659.     return "'ière";
  660.     } else {
  661.     return "ième";
  662.     }
  663. }
  664.  
  665. # ordinalize_swedish
  666. #
  667. # A function to ordinalize in Swedish.    Thanks go to Johan Linde
  668. # <jl@theophys.kth.se> for the code!
  669.  
  670. sub ordinalize_swedish {
  671.     local($count) = @_;
  672.     local($last, $last2);
  673.  
  674.     $last2 = $count % 100;
  675.     $last = $count % 10;
  676.  
  677.     if ($last2 < 10 || $last2 > 12) {
  678.     return ":a" if ($last == 1 || $last == 2);
  679.     }
  680.  
  681.     return ":e";
  682. }
  683.  
  684.  
  685. ########################################################################
  686. #
  687. # Output functions
  688. #
  689. # The following are the routines that actually convert the number
  690. # of accesses into something that we print out.
  691. #
  692. # The name of each function is "output_" followed by the program's name.
  693. # For instance, is the program is called "counter" then "output_counter"
  694. # will be called; a program called "counterbanner" will call
  695. # "output_counterbanner" to get the output.
  696. #
  697. # If the function is not defined, then "output_counter" will be called.
  698. #
  699.  
  700. # output_counter
  701. #
  702. # The simplest function: just returns the number of accesses and the link.
  703.  
  704. sub output_counter {
  705.     local($count) = @_;
  706.  
  707.     return &translate_output($count), $Link; # we return the count and the link
  708. }
  709.  
  710.  
  711. # output_counterord
  712. #
  713. # Return the number of accesses as an ordinal number.  (ie. 1st, 2nd, 3rd, 4th)
  714.  
  715. sub output_counterord {
  716.     local($count) = @_;
  717.  
  718.     return &translate_output($count . &ordinalize($count)), $Link;
  719. }
  720.  
  721.  
  722. # output_counterbanner
  723. #
  724. # A somewhat silly one that uses the "banner" command to print out the
  725. # count.  :)  You might need to change the path to make it work.
  726.  
  727. sub output_counterbanner {
  728.     local($count) = @_;
  729.  
  730.     $banner = `banner $count`;
  731.  
  732.     return "<pre>$banner</pre>"; # return no link here (it would be annoying)
  733. }
  734.  
  735.  
  736. # output_counterfiglet
  737. #
  738. # An even sillier one than counterbanner.  :)
  739.  
  740. sub output_counterfiglet {
  741.     local($count) = @_;
  742.  
  743.     $fig = "echo $count | /usr/games/figlet";   # setup command line
  744.     $fig .= " -f $arg{'f'}" if $arg{"f"};       # use a different font?
  745.     $fig = `$fig`;
  746.     $fig =~ s!&!&!;
  747.     $fig =~ s!<!<!;
  748.     return "<br><pre>" . $fig . "</pre>";       # note no link here, either
  749. }
  750.  
  751.  
  752.  
  753. #########################################################################
  754. #
  755. # Conversion functions
  756. #
  757.  
  758. # UpdateVersion
  759. #
  760. # Convert a version 1file into a version 2 file.
  761.  
  762. sub UpdateVersion1 {
  763.     local ($contents,$dummy);
  764.     local ($oldsep) = $/;
  765.  
  766.     $/ = "";
  767.     seek(COUNT,0,0);            # Go to the beginning of the file
  768.     $contents = <COUNT>;
  769.     seek(COUNT,0,0);
  770.     print COUNT "$FileVersion\n";
  771.     print COUNT $contents;
  772.     seek(COUNT,0,0);
  773.     $/ = $oldsep;
  774.     $dummy = <COUNT>;        # Skip the new line
  775. }
  776.  
  777.  
  778. # ConvertDocV1
  779. #
  780. # Convert the a version 1 line into a version 2 line
  781.  
  782. sub ConvertDocV1 {
  783.     local ($doc_uri,$old_uri,$accesses,$location) = @_;
  784.     local ($contents,$dummy,$oldsep);
  785.  
  786.     $oldsep = $/;
  787.  
  788.     seek (COUNT,$location,0);   # Skip the line in question
  789.     $dummy = <COUNT>;
  790.  
  791.     $/ = "";                    # Read in the whole file
  792.     $contents = <COUNT>;
  793.  
  794.     seek (COUNT,$location,0);
  795.  
  796.     local ($longaccesses,$hexflags);
  797.     $longaccesses = sprintf("%010.10d", $accesses);
  798.     $hexflags = sprintf("%04.4x", $flags);
  799.  
  800.     # Print out the new stuff
  801.     print COUNT "'$doc_uri' $longaccesses $hexflags\n";
  802.     print COUNT $contents;
  803.  
  804.     $/ = $oldsep;
  805. }
  806.